perm filename CYCLIC.SG[DEN,LMM] blob
sn#069190 filedate 1973-10-28 generic text, type T, neo UTF8
(FILECREATED "28-OCT-73 1:48:19" S-CYCLIC)
(LISPXPRINT (QUOTE CYCLICVARS)
T)
(RPAQQ CYCLICVARS
((* Unfortunately, this file is a catch-all for
not-easy-to-classify files)
(FNS VALENCE FVPARTITION1 FVPART1 MINLOOPS MAXLOOPS
SUPERATOMPARTITIONS MAXUNSATL COMPUTEFV ROWS
BIVALENTPARTITIONS TRIMZEROS TD LOOPPARTITIONS1 JLIST
LPROWS CLPARTLP1 NUMPARTITIONS NUMPARTITIONS'
FVPARTITIONS EVENP LOOPPARTITIONS MAXREST CLBYVALENCE)
(RECORDS SUPERATOMPARTITION FVPARTITION LOOPPARTITION)
(PROP VALENCE C H O N CH CH2 CH3 W OH CHOH COH Y #)))
(* Unfortunately, this file is a catch-all for not-easy-to-classify
files)
(DEFINEQ
(VALENCE
[LAMBDA (X)
(OR (COND
((NULL X)
2)
((NUMBERP X)
X)
((ATOM X)
(GETP X (QUOTE VALENCE)))
(T (FREEVALENCESIZE X)))
(HELP "WHAT IS VALENCE OF" X])
(FVPARTITION1
[LAMBDA (N VL S)
(COND
((NULL VL)
(LIST NIL))
(T (FOR I FROM [MAX 0 (IDIFFERENCE N (sum (ITIMES SP X)
for X
in (CDR VL)
as SP
from (ADD1 S]
TO (MIN N (ITIMES (CAR VL)
S))
AS PARTREST IS (FVPARTITION1 (IDIFFERENCE N I)
(CDR VL)
(ADD1 S))
FOR FIRSTPART
IN (FVPART1 I (CAR VL)
S)
FOR RESTPART
IN PARTREST XLIST (CONS FIRSTPART RESTPART])
(FVPART1
[LAMBDA (N MAXSUM MAXOCCUR)
(COND
((ZEROP MAXOCCUR)
(LIST NIL))
(T (FOR I FROM [MAX 0 (IDIFFERENCE N (ITIMES MAXSUM (SUB1
MAXOCCUR]
TO (MIN MAXSUM (IQUOTIENT N MAXOCCUR)) FOR REST
IN (FVPART1 (IDIFFERENCE N (ITIMES I MAXOCCUR))
(IDIFFERENCE MAXSUM I)
(SUB1 MAXOCCUR))
XLIST
(CONS I REST])
(MINLOOPS
[LAMBDA (VALENCELIST)
(MAX 0 (PROG (MXV TD)
(SETQ TD (SETQ MXV 0))
(FOR X IN (CDR VALENCELIST) AS VALENCE FROM 3
WHEN (NOT (ZEROP X))
DO (COND
((IGREATERP VALENCE MXV)
(SETQ MXV VALENCE)))
(SETQ TD (IPLUS (ITIMES X VALENCE)
TD)))
(RETURN (IDIFFERENCE MXV (IQUOTIENT TD 2])
(MAXLOOPS
[LAMBDA (VALENCELIST)
(MIN (CAR VALENCELIST)
(FOR X IN (CDR (CDR VALENCELIST)) AS K FROM 4
SUM (ITIMES X (SUB1 (IQUOTIENT K 2])
(SUPERATOMPARTITIONS
[LAMBDA (CL U)
(PROG (CL1 SZ MXUI VI)
[SETQ CL1 (MAPCONC CL (FUNCTION (LAMBDA (PR)
(AND (EQ (VALENCE (CAR PR))
1)
(LIST PR]
(SETQ CL (CLDIFF CL CL1))
(SETQ SZ (CLCOUNT CL))
(FOR PARTSIZE FROM 2 TO SZ FOR VHAT IN (CLPARTS CL PARTSIZE)
AS REMATS IS (APPEND CL1 (CLDIFF CL VHAT)) FOR #PARTS
FROM 1
TO (IQUOTIENT PARTSIZE 2) FOR PARTITION
IN (CLPARTITIONSN VHAT #PARTS 2)
AS VI IS (CLCREATE PARTITION)
AS MXUI IS (MAXUNSATL VI (COND
((AND (NULL REMATS)
(NULL (CDR PARTITION)))
U)))
FOR UI
IN (NUMPARTITIONS' U 1 MXUI (collect CDR in VI))
XLIST
(create SUPERATOMPARTITION SUPERATOMPARTS←(CLCREATE
(collect (CONS Y X) for X
in (CLEXPAND VI)
as Y
in UI))
REMAININGATOMS← REMATS])
(MAXUNSATL
[LAMBDA (PC U)
(* Note U is either NIL (normal) or it is equal to
the unsaturation in the case where remats is NIL and
there is only one part here)
(MAPCAR
PC
(FUNCTION (LAMBDA (PARTNUM)
(PROG (N TD M)
(SETQ N (SETQ TD (SETQ M 0)))
[for PR in (CAR PARTNUM)
do (SETQ N (IPLUS N (CDR PR)))
[SETQ TD (IPLUS TD (ITIMES (CDR PR)
(VALENCE (CAR PR]
(SETQ M (MAX M (VALENCE (CAR PR]
(SETQ N (IDIFFERENCE (IPLUS 2 TD)
(ITIMES 2 N)))
(RETURN
(IQUOTIENT
[IPLUS N (MIN (COND
((AND U (EQ (ITIMES U 2)
N))
0)
(T -1))
(IDIFFERENCE TD (ITIMES 2 M]
2])
(COMPUTEFV
[LAMBDA (U CL)
(PROG (TD N)
(SETQ TD (SETQ N 0))
[MAPC CL (FUNCTION (LAMBDA (PR)
(SETQ TD (IPLUS (ITIMES (VALENCE (CAR PR))
(CDR PR))
TD))
(SETQ N (IPLUS (CDR PR)
N]
(RETURN (IDIFFERENCE (IPLUS 2 TD)
(ITIMES 2 (IPLUS N U])
(ROWS
[LAMBDA (LL)
(COND
((NULL LL)
(QUOTE (NIL)))
(T (CONS (collect CAR in LL)
(ROWS (collect CDR in (CDR LL])
(BIVALENTPARTITIONS
[LAMBDA (VL) (* Number of parts LE
number of bivalents and
number of edges)
(FOR I TO (MIN (CAR VL)
(IQUOTIENT (TD (CDR VL)
3)
2))
JOIN (NUMPARTITIONS (CAR VL)
I 1 NIL])
(TRIMZEROS
[LAMBDA (L)
(* RETURNS NIL IF L IS ALL ZEROS , AND THE TAIL OF L
WHICH IS NOT ALL ZEROS OTHERWISE)
(PROG (TEM)
(COND
([AND L (OR (SETQ TEM (TRIMZEROS (CDR L)))
(NOT (ZEROP (CAR L]
(CONS (CAR L)
TEM])
(TD
[LAMBDA (VL J)
(FOR I FROM J AS X IN VL SUM (ITIMES I X])
(LOOPPARTITIONS1
[LAMBDA (P VL J)
(COND
((NULL VL)
(LIST NIL))
(T (FOR PJ FROM (MAX 0 (IDIFFERENCE P (MAXREST VL J)))
TO (MIN P (ITIMES (SUB1 (IQUOTIENT J 2))
(CAR VL)))
AS RESTL IS (LOOPPARTITIONS1 (IDIFFERENCE P PJ)
(CDR VL)
(ADD1 J))
FOR THISPART
IN (FVPART1 PJ (CAR VL)
(SUB1 (IQUOTIENT J 2)))
FOR RESTPART
IN RESTL XLIST (CONS THISPART RESTPART])
(JLIST
[LAMBDA (LL N)
(COND
((NULL LL)
NIL)
[(NULL (CDR LL))
(LIST (CAR (NTH (CAR LL)
N]
(T (CONS (CAR (NTH (CAR LL)
N))
(JLIST (CDDR LL)
(ADD1 N])
(LPROWS
[LAMBDA (LPP VL)
(SETQ LPP (CONS NIL LPP))
(for S from 4 as V in [CONS (CAR VL)
(for V2 in (CDR VL) as PL in LPP
collect (IDIFFERENCE V2
(SUMOF PL]
collect (CONS V (JLIST (SETQ LPP (CDR LPP))
(SUB1 (IQUOTIENT S 2])
(CLPARTLP1
[LAMBDA (CL ROW N)
(COND
((NULL ROW)
(LIST NIL))
((ZEROP (CAR ROW))
(CLPARTLP1 CL (CDR ROW)
(ADD1 N)))
(T (FOR EP IN (CLPARTS CL (ITIMES N (CAR ROW)))
AS RPL IS (CLPARTLP1 (CLDIFF CL EP)
(CDR ROW)
(ADD1 N))
FOR EEP
IN (CLEQUALPARTS EP (CAR ROW)
N)
FOR RP
IN RPL XLIST (APPEND (CLCREATE EEP)
RP])
(NUMPARTITIONS
[LAMBDA (N NUMPARTS MINPART MAXPART)
(COND
[(EQ NUMPARTS 1)
(COND
((OR (IGREATERP MINPART N)
(AND MAXPART (ILESSP MAXPART N)))
NIL)
(T (LIST (LIST N]
(T (FOR I FROM (COND
[MAXPART (MAX MINPART
(IDIFFERENCE N
(ITIMES (SUB1
NUMPARTS)
MAXPART]
(T MINPART))
TO (COND
(MAXPART (MIN MAXPART (IQUOTIENT N NUMPARTS)))
(T (IQUOTIENT N NUMPARTS)))
FOR RESTPART
IN (NUMPARTITIONS (IDIFFERENCE N I)
(SUB1 NUMPARTS)
I MAXPART)
XLIST
(CONS I RESTPART])
(NUMPARTITIONS'
[LAMBDA (U MN MAXIMA OCCURLIST)
(COND
((NULL (CDR OCCURLIST))
(NUMPARTITIONS U (CAR OCCURLIST)
MN
(CAR MAXIMA)))
(T (FOR FIRSTPART
FROM [MAX MN (IDIFFERENCE
(IDIFFERENCE (CIELING U)
(ITIMES (SUB1 (CAR OCCURLIST))
(CAR MAXIMA)))
(sum (ITIMES X Y) for X in (CDR MAXIMA)
as Y
in (CDR OCCURLIST]
TO (MIN (CAR MAXIMA)
(IQUOTIENT (IDIFFERENCE U (SUMOF (CDR OCCURLIST)))
(CAR OCCURLIST)))
FOR RESTPART
IN [COND
((EQ (CAR OCCURLIST)
1)
(NUMPARTITIONS' (IDIFFERENCE U FIRSTPART)
1
(CDR MAXIMA)
(CDR OCCURLIST)))
(T (NUMPARTITIONS' (IDIFFERENCE U FIRSTPART)
FIRSTPART MAXIMA
(CONS (SUB1 (CAR OCCURLIST))
(CDR OCCURLIST]
XLIST
(CONS FIRSTPART RESTPART])
(FVPARTITIONS
[LAMBDA (FV VL)
(FOR FVP IN (FVPARTITION1 FV (CDR VL)
1)
AS FVR IS (ROWS FVP)
COLLECT (create FVPARTITION NEWVL←(collect
(IDIFFERENCE (IPLUS V (SUMOF ROW))
(SUMOF COL))
for ROW
in FVR
as COL
in (CONS NIL FVP)
as V
in VL)
FVR← FVR])
(EVENP
[LAMBDA (X)
(ZEROP (IREMAINDER X 2])
(LOOPPARTITIONS
[LAMBDA (P VL)
(FOR LPP IN (LOOPPARTITIONS1 P (CDDR VL)
4)
AS ROWS IS (LPROWS LPP VL)
AS NEWVL IS (CONS (SUMOF (CDAR ROWS))
(MAPCAR (CDR ROWS)
(FUNCTION SUMOF)))
XLIST
(FOR K FROM 0 TO (MIN (IDIFFERENCE (CAR VL)
P)
(IQUOTIENT (TD (CDR NEWVL)
3)
2))
FOR BP
IN (NUMPARTITIONS (CAR VL)
(IPLUS P K)
1 NIL)
AS CLBP IS (CLCREATE BP) FOR EL
IN (CLPARTS CLBP K) FOR LPL
IN (CLPARTITIONSL (CLDIFF CLBP EL)
(CDRLIST ROWS))
XLIST
(create LOOPPARTITION LOOPVL← NEWVL EDGELABELS← EL
LOOPLABELS← LPL])
(MAXREST
[LAMBDA (VL J)
(FOR X IN (CDR VL) AS K FROM (ADD1 J)
SUM (ITIMES X (SUB1 (IQUOTIENT K 2])
(CLBYVALENCE
[LAMBDA (CL)
(SETQ CL (GROUPBY [FUNCTION (LAMBDA (PR)
(VALENCE (CAR PR]
CL))
(FOR I FROM 2 TO (FOR X IN CL MAXIMUM (CAR X))
COLLECT (CDR (ASSOC I CL])
)
(RECORD SUPERATOMPARTITION (SUPERATOMPARTS . REMAININGATOMS))
(RECORD FVPARTITION (NEWVL . FVR))
(RECORD LOOPPARTITION (LOOPVL EDGELABELS . LOOPLABELS))
(DEFLIST(QUOTE(
(C 4)
(H 1)
(O 2)
(N 3)
(CH 3)
(CH2 2)
(CH3 1)
(W 2)
(OH 1)
(CHOH 2)
(COH 3)
(Y 3)
(# 2)
))(QUOTE VALENCE))
STOP